home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_ghostscript.idb / usr / freeware / lib / ghostscript / 3.33 / wrfont.ps.z / wrfont.ps
Encoding:
Text File  |  1998-05-21  |  17.4 KB  |  658 lines
  1. %    Copyright (C) 1991, 1995 Aladdin Enterprises.  All rights reserved.
  2. % 
  3. % This file is part of GNU Ghostscript.
  4. % 
  5. % GNU Ghostscript is distributed in the hope that it will be useful, but
  6. % WITHOUT ANY WARRANTY.  No author or distributor accepts responsibility to
  7. % anyone for the consequences of using it or for whether it serves any
  8. % particular purpose or works at all, unless he says so in writing.  Refer
  9. % to the GNU Ghostscript General Public License for full details.
  10. % 
  11.  
  12. % wrfont.ps
  13. % Write out a Type 1 font in readable, reloadable form.
  14. % Note that this does NOT work on protected fonts, such as Adobe fonts
  15. % (unless you have loaded unprot.ps first, in which case you may be
  16. % violating the Adobe license).
  17.  
  18. % ****** NOTE: This file must be kept consistent with gs_pfile.ps.
  19.  
  20. /wrfont_dict 100 dict def
  21. wrfont_dict begin
  22.  
  23. % ------ Options ------ %
  24.  
  25. % Define whether to use eexec encryption for the font.
  26. % eexec encryption is only useful for compatibility with Adobe Type Manager
  27. % and other programs; it only slows Ghostscript down.
  28.    /eexec_encrypt false def
  29.  
  30. % Define whether to write out the CharStrings in binary or in hex.
  31. % Binary takes less space on the file, but isn't guaranteed portable.
  32.    /binary_CharStrings false def
  33.  
  34. % Define whether to use binary token encodings when possible.
  35. % Binary tokens are smaller and load faster, but are a Level 2 feature.
  36.    /binary_tokens false def
  37.  
  38. % Define whether to encrypt the CharStrings on the file.  (CharStrings
  39. % are always encrypted in memory.)  Unencrypted CharStrings load about
  40. % 20% slower, but make the files compress much better for transport.
  41.    /encrypt_CharStrings true def
  42.  
  43. % Define whether the font must provide standard PostScript language
  44. % equivalents for any facilities it uses that are provided in Ghostscript
  45. % but are not part of the standard PostScript language.
  46.    /standard_only true def
  47.  
  48. % Define the value of lenIV to use in writing out the font.
  49. % use_lenIV = 0 produces the smallest output, but this may not be
  50. % compatible with old Adobe interpreters.  use_lenIV = -1 means
  51. % use the value of lenIV from the font.
  52.    /use_lenIV -1 def
  53.  
  54. % Define whether to produce the smallest possible output, relying
  55. % as much as possible on Ghostscript-specific support code.
  56. % Taking full advantage of this requires the following settings:
  57. % binary_CharStrings = true, binary_tokens = true, standard_only = false.
  58.    /smallest_output false def
  59.  
  60. % Define whether to write out all currently known Encodings by name,
  61. % or only StandardEncoding and ISOLatin1Encoding.
  62.    /name_all_Encodings false def
  63.  
  64. % ---------------- Runtime support ---------------- %
  65.  
  66. /.packedfilefilter where
  67.  { pop }
  68.  { (gs_pfile.ps) run }
  69. ifelse
  70.  
  71. % ------ Output utilities ------ %
  72.  
  73. % By convention, the output file is named psfile.
  74.  
  75. % Define some utilities for writing the output file.
  76.    /wtstring 2000 string def
  77.    /wb {psfile exch write} bind def
  78.    /wnb {/wb load repeat} bind def
  79.    /w1 {psfile exch write} bind def
  80.    /ws {psfile exch writestring} bind def
  81.    /wl {ws (\n) ws} bind def
  82.    /wt {wtstring cvs ws ( ) ws} bind def
  83.    /wd        % Write a dictionary.
  84.     { dup length wo {dict dup begin} wol { we } forall
  85.       {end} wol
  86.     } bind def
  87.    /wld        % Write a large dictionary more efficiently.
  88.            % Ignore the readonly attributes.
  89.     { dup length wo {dict dup begin} wol
  90.       0 exch
  91.        { exch wo wo () wl
  92.      1 add dup 200 eq
  93.       { wo ({def} repeat) wl 0 }
  94.      if
  95.        }
  96.       forall
  97.       dup 0 ne
  98.        { wo ({def} repeat) wl }
  99.        { pop }
  100.       ifelse
  101.       (end) ws
  102.     } bind def
  103.    /we        % Write a dictionary entry.
  104.     { exch wo wo /def cvx wo (\n) ws
  105.     } bind def
  106.    /wcs        % Write a CharString (or Subrs entry)
  107.     { dup type /stringtype eq
  108.        { 4330 exch changelenIV 0 ge
  109.           {    % Add some leading garbage bytes.
  110.         wtstring changelenIV 2 index length getinterval
  111.         .type1decrypt exch pop
  112.         wtstring exch 0 exch length changelenIV add getinterval
  113.       }
  114.       {    % Drop some leading garbage bytes.
  115.         wtstring .type1decrypt exch pop
  116.         changelenIV neg 1 index length 1 index sub getinterval
  117.       }
  118.      ifelse
  119.          binary_tokens encrypt_CharStrings and
  120.       { % Suppress recognizing the readonly status of the string.
  121.         4330 exch dup .type1encrypt exch pop wo
  122.       }
  123.       { encrypt_CharStrings
  124.          { 4330 exch dup .type1encrypt exch pop
  125.          } if
  126.         smallest_output
  127.          { wo
  128.          }
  129.          { readonly dup length wo
  130.            binary_tokens not { ( ) ws } if
  131.            readproc ws wx
  132.          }
  133.         ifelse
  134.       }
  135.      ifelse
  136.        }
  137.        { wo        % PostScript procedure
  138.        }
  139.       ifelse
  140.     } bind def
  141.  
  142. % Construct the inversion of the system name table.
  143.    /SystemNames where
  144.     { pop /snit 256 dict def
  145.       0 1 255
  146.        { dup SystemNames exch get
  147.          dup null ne { exch snit 3 1 roll put } { pop pop } ifelse
  148.        }
  149.       for
  150.     }
  151.     { /snit 1 dict def
  152.     }
  153.    ifelse
  154.  
  155. % Write an object, using binary tokens if requested and possible.
  156.    /woa        % write in ascii
  157.     { psfile exch write==only
  158.     } bind def
  159.  
  160.             % Lookup table for ASCII output.
  161.  
  162.    /intbytes    % int nbytes -> byte*
  163.     { { dup 255 and exch -8 bitshift } repeat pop
  164.     } bind def
  165.    /wotta 10 dict dup begin
  166.       { /booleantype /integertype }
  167.       { { ( ) ws woa } def }
  168.      forall
  169.         % Iterate over arrays so we can print operators.
  170.      /arraytype
  171.       { dup xcheck {(}) ({)} {(]) ([)} ifelse ws exch dup wol exch ws wop
  172.       } bind def
  173.      /dicttype
  174.       { ( ) ws wd } def
  175.      /nametype
  176.       { dup xcheck { ( ) ws } if woa
  177.       } bind def
  178.         % Map back operators to their names,
  179.         % so we can write procedures.
  180.      /nulltype
  181.       { pop ( null) ws
  182.       } bind def
  183.      /operatortype
  184.       { wtstring cvs cvn cvx wo
  185.       } bind def
  186.         % Convert reals to integers if possible.
  187.      /realtype
  188.       { dup cvi 1 index eq { cvi wo } { ( ) ws woa } ifelse
  189.       } bind def
  190.         % == truncates strings longer than 200 characters!
  191.      /stringtype
  192.       { (\() ws dup
  193.      { dup dup 32 lt exch 127 ge or
  194.         { (\\) ws dup -6 bitshift 48 add w1
  195.           dup -3 bitshift 7 and 48 add w1
  196.           7 and 48 add
  197.         }
  198.         { dup dup -2 and 40 eq exch 92 eq or {(\\) ws} if
  199.         }
  200.        ifelse w1
  201.      }
  202.     forall
  203.     (\)) ws wop
  204.       } bind def
  205.      /packedarraytype
  206.       { ([) ws dup { wo } forall
  207.     encodingnames 1 index known
  208.         % This is an encoding, but not one of the standard ones.
  209.         % Use the built-in encoding only if it is available.
  210.      { encodingnames exch get wo
  211.        ({findencoding}stopped{pop) ws
  212.        (}{counttomark 1 add 1 roll cleartomark}ifelse)
  213.      }
  214.      { pop ()
  215.      }
  216.     ifelse
  217.     (/packedarray where{pop counttomark packedarray exch pop}{]readonly}ifelse) ws
  218.     wl
  219.       }
  220.      def
  221.    end def
  222.  
  223.             % Lookup table for binary output.
  224.  
  225.    /wottb 8 dict dup begin
  226.    wotta currentdict copy pop
  227.      /integertype
  228.       { dup dup 127 le exch -128 ge and
  229.          { 136 wb 255 and wb }
  230.      { dup dup 32767 le exch -32768 ge and
  231.         { 134 wb 2 intbytes wb wb }
  232.         { 132 wb 4 intbytes wb wb wb wb }
  233.        ifelse
  234.      }
  235.     ifelse
  236.       } bind def
  237.      /nametype
  238.       { dup snit exch known
  239.          { dup xcheck { 146 } { 145 } ifelse wb
  240.        snit exch get wb
  241.      }
  242.      { wotta /nametype get exec
  243.      }
  244.     ifelse
  245.       } bind def
  246.      /stringtype
  247.       { dup dup length dup 255 le { 142 2 } { 2 intbytes 143 3 } ifelse wnb
  248.     ws wop
  249.       } bind def
  250.    end def
  251.  
  252.    /wop        % Write object protection
  253.      { wcheck not { /readonly cvx wo } if
  254.      } bind def
  255.    /wo        % Write an object.
  256.      { dup type binary_tokens { wottb } { wotta } ifelse
  257.        exch get exec
  258.      } bind def
  259.    /wol        % Write a list of objects.
  260.      { { wo } forall
  261.      } bind def
  262.  
  263. % Write a hex string for Subrs or CharStrings.
  264.    /wx        % string ->
  265.     { binary_CharStrings
  266.        { ws
  267.        }
  268.        { % Some systems choke on very long lines, so
  269.      % we break up the hexstring into chunks of 50 characters.
  270.       { dup length 25 le {exit} if
  271.         dup 0 25 getinterval psfile exch writehexstring (\n) ws
  272.         dup length 25 sub 25 exch getinterval
  273.       } loop
  274.      psfile exch writehexstring
  275.        } ifelse
  276.     } bind def
  277.  
  278. % ------ CharString encryption utilities ------ %
  279.  
  280. /enc_dict 20 dict def
  281. 1 dict begin
  282. /bind { } def        % make sure we can print out the procedures
  283. enc_dict begin
  284.  
  285. (type1enc.ps) run
  286. enc_dict /.type1decrypt undef        % we don't need this
  287.  
  288. end end
  289.  
  290. enc_dict { 1 index where { pop pop pop } { def } ifelse } forall
  291.  
  292. % ------ Other utilities ------ %
  293.  
  294. % Test whether two values are equal (for default dictionary entries).
  295.    /valueeq        % <obj1> <obj2> valueeq <bool>
  296.     { 2 copy eq
  297.        { pop pop true }
  298.        {    % Special hack for comparing FontMatrix values
  299.      dup type /arraytype eq 2 index type /arraytype eq and
  300.       { dup length 2 index length eq
  301.          { true 0 1 3 index length 1 sub
  302.         {    % Stack: arr1 arr2 true index
  303.           3 index 1 index get 3 index 3 -1 roll get eq not
  304.            { pop false exit }
  305.           if
  306.         }
  307.            for 3 1 roll pop pop
  308.          }
  309.          { pop pop false
  310.          }
  311.         ifelse
  312.       }
  313.       { pop pop false
  314.       }
  315.      ifelse
  316.        }
  317.       ifelse
  318.     } bind def
  319.  
  320. % ------ The main program ------ %
  321.  
  322. % Define the dictionary of keys to skip because they are treated specially.
  323. /.fontskipkeys mark
  324.   /CharStrings dup
  325.   /Encoding dup
  326.   /FDepVector dup
  327.   /FID dup
  328.   /FontInfo dup
  329.   /Metrics dup
  330.   /Metrics2 dup
  331.   /Private dup
  332. .dicttomark def
  333. /.minfontskipkeys mark
  334.   .fontskipkeys { } forall
  335.   /FontName dup
  336.   /UniqueID dup
  337. .dicttomark def
  338. /.privateskipkeys mark
  339.   /ND dup
  340.   /NP dup
  341.   /RD dup
  342.   /Subrs dup
  343. .dicttomark def
  344. /.minprivateskipkeys mark
  345.   .privateskipkeys { } forall
  346.   /MinFeature dup
  347.   /Password dup
  348.   /UniqueID dup
  349. .dicttomark def
  350.  
  351. % Define the procedures for the Private dictionary.
  352. % These must be defined without `bind',
  353. % for the sake of the DISKFONTS feature.
  354. 4 dict begin
  355.  /-! {string currentfile exch readhexstring pop} def
  356.  /-| {string currentfile exch readstring pop} def
  357.  /|- {readonly def} def
  358.  /| {readonly put} def
  359. currentdict end /encrypted_procs exch def
  360. 4 dict begin
  361.  /-! {string currentfile exch readhexstring pop
  362.    4330 exch dup .type1encrypt exch pop} def
  363.  /-| {string currentfile exch readstring pop
  364.    4330 exch dup .type1encrypt exch pop} def
  365.  /|- {readonly def} def
  366.  /| {readonly put} def
  367. currentdict end /unencrypted_procs exch def
  368.  
  369. % Construct an inverse dictionary of encodings.
  370. /encodingnames mark
  371.  StandardEncoding /StandardEncoding
  372.  ISOLatin1Encoding /ISOLatin1Encoding
  373.  SymbolEncoding /SymbolEncoding
  374.  DingbatsEncoding /DingbatsEncoding
  375.  /resourceforall where
  376.   { pop (*) { cvn dup findencoding exch } 100 string /Encoding resourceforall }
  377.  if
  378. .dicttomark def
  379.  
  380. % Invert the standard encodings.
  381. .knownEncodings length 256 mul dict begin
  382.   0 .knownEncodings
  383.    {  { currentdict 1 index known { pop } { 1 index def } ifelse
  384.     1 add
  385.       }
  386.      forall
  387.    }
  388.   forall pop
  389. currentdict end /inverseencodings exch def
  390.  
  391. /writefont        % <psfile> writefont - (writes the current font)
  392.  { /psfile exch def
  393.    /Font currentfont def
  394.    /FontInfo Font /FontInfo .knownget not { 0 dict } if def
  395.    /FontType Font /FontType get def
  396.    /hasPrivate Font /Private known def
  397.    /Private hasPrivate { Font /Private get } { 0 dict } ifelse def
  398.    /readproc binary_CharStrings { (-| ) } { (-! ) } ifelse def
  399.    /privateprocs
  400.      encrypt_CharStrings binary_tokens not and
  401.       { encrypted_procs } { unencrypted_procs } ifelse
  402.      def
  403.    /addlenIV false def
  404.    /changelenIV use_lenIV 0 lt
  405.     { 0 }
  406.     { use_lenIV Private /lenIV .knownget not
  407.        { 4 /addlenIV use_lenIV 4 ne def } if sub }
  408.    ifelse def
  409.    /minimize
  410.      smallest_output
  411.      FontType 1 eq and
  412.      Font /UniqueID known and
  413.    def
  414.    (%!FontType) ws FontType wtstring cvs ws (-1.0: ) ws
  415.      currentfont /FontName get wt
  416.      FontInfo /version .knownget not { (001.001) } if wl
  417.    FontInfo /CreationDate .knownget { (%%Creation Date: ) ws wl } if
  418.    FontInfo /VMusage .knownget
  419.     { (%%VMusage: ) ws dup wt wtstring cvs wl }
  420.    if
  421.    (systemdict begin) wl
  422.  
  423. % If we're going to use eexec, create the filters now.
  424.    /realpsfile psfile def
  425.    eexec_encrypt
  426.     { /eexecfilter psfile binary_CharStrings not
  427.        { pop /bxstring 35 string def
  428.       { pop dup length 0 ne
  429.          { realpsfile exch writehexstring realpsfile (\n) writestring }
  430.          { pop }
  431.         ifelse bxstring
  432.       }
  433.      /NullEncode filter dup /hexfilter exch def
  434.        }
  435.       if 55665 /eexecEncode filter def
  436.     }
  437.    if
  438.  
  439. % Turn on binary tokens if relevant.
  440.    binary_tokens { (currentobjectformat 1 setobjectformat) wl } if
  441.  
  442. % If the file has a UniqueID, write out a check against loading it twice.
  443.    minimize
  444.     { Font /FontName get wo
  445.       Font /UniqueID get wo
  446.       Private length addlenIV { 1 add } if wo
  447.       Font length 1 add wo        % +1 for FontFile
  448.       ( .checkexistingfont) wl
  449.     }
  450.     { Font /UniqueID known
  451.        { ({} FontDirectory) ws Font /FontName get dup wo ( known) wl
  452.      ( {) ws wo ( findfont dup /UniqueID known) wl
  453.      (    { dup /UniqueID get) ws Font /UniqueID get wo ( eq exch /FontType get 1 eq and }) wl
  454.      (    { pop false } ifelse) wl
  455.      (    { pop save /restore load } if) wl
  456.      ( } if) wl
  457.        }
  458.       if
  459.     }
  460.    ifelse
  461.  
  462. % If we are writing unencrypted CharStrings for a standard environment,
  463. % write out the encryption procedures.
  464.    privateprocs unencrypted_procs eq standard_only and
  465.     { (systemdict /.type1encrypt known) wl
  466.       ( { save /restore load } { { } } ifelse) wl
  467.       (userdict begin) wl
  468.       enc_dict { we } forall
  469.       (end exec) wl
  470.     }
  471.    if
  472.  
  473. % Write out the creation of the font dictionary and FontInfo.
  474.    minimize not
  475.     { Font length 1 add wo {dict begin} wol        % +1 for FontFile
  476.     }
  477.    if
  478.    (/FontInfo ) ws FontInfo wd {readonly def} wol
  479.  
  480. % Write out the other fixed entries in the font dictionary.
  481.    Font begin
  482.    Font
  483.     { minimize
  484.        { .minfontskipkeys 2 index known
  485.       { pop pop
  486.       }
  487.       { //.compactfontdefault 2 index .knownget
  488.          { 1 index valueeq { pop pop } { we } ifelse }
  489.          { we }
  490.         ifelse
  491.       }
  492.      ifelse
  493.        }
  494.        { .fontskipkeys 2 index known { pop pop } { we } ifelse
  495.        }
  496.       ifelse
  497.     } forall
  498.    /Encoding
  499.    encodingnames Encoding known
  500.    name_all_Encodings
  501.    Encoding StandardEncoding eq or
  502.    Encoding ISOLatin1Encoding eq or and
  503.     { encodingnames Encoding get cvx }
  504.     { Encoding }
  505.    ifelse
  506.    dup /StandardEncoding cvx eq minimize and
  507.     { pop pop }
  508.     { we }
  509.    ifelse
  510.  
  511. % Write the FDepVector, if any.
  512.    Font /FDepVector .knownget
  513.     { {/FDepVector [} wol
  514.        { /FontName get wo {findfont} wol () wl } forall
  515.       {] readonly def} wol
  516.     }
  517.    if
  518.  
  519. % Write out the Metrics, if any.
  520.    Font /Metrics .knownget
  521.     { (/Metrics ) ws wld {readonly def} wol
  522.     }
  523.    if
  524.    Font /Metrics2 .knownget
  525.     { (/Metrics2 ) ws wld {readonly def} wol
  526.     }
  527.    if
  528.  
  529. % Start the eexec-encrypted section, if applicable.
  530.   eexec_encrypt
  531.    { {currentdict currentfile eexec} wol () wl
  532.      /psfile eexecfilter store
  533.      (\000\000\000\000) ws {begin} wol
  534.    }
  535.   if
  536.  
  537. % Create and initialize the Private dictionary, if any.
  538.    hasPrivate
  539. {
  540.    Private
  541.    minimize
  542.     { begin {Private dup begin}
  543.     }
  544.     {  dup length privateprocs length add dict copy begin
  545.        privateprocs { readonly def } forall
  546.        /Private wo
  547.        currentdict length 1 add wo {dict dup begin}
  548.     }
  549.    ifelse wol () wl
  550.    currentdict
  551.     { 1 index minimize { .minprivateskipkeys } { .privateskipkeys } ifelse
  552.       exch known
  553.        { pop pop }
  554.        { 1 index /lenIV eq use_lenIV 0 ge and { pop use_lenIV } if we }
  555.       ifelse
  556.     } forall
  557.    addlenIV { /lenIV use_lenIV we } if
  558. }
  559. if
  560.  
  561. % Write the Subrs entries, if any.
  562.    currentdict /Subrs known
  563.     { (/Subrs[) wl
  564.       Subrs
  565.        { dup null ne
  566.       { wcs minimize not { () wl } if }
  567.       { pop /null cvx wo }
  568.      ifelse
  569.        } forall
  570.       {] dup {readonly pop} forall readonly def} wol () wl
  571.     }
  572.    if
  573.  
  574. % Wrap up the Private dictionary.
  575.    hasPrivate
  576.     { end            % Private
  577.       minimize
  578.        { {end readonly pop} }    % Private
  579.        { {end readonly def} }    % Private in font
  580.       ifelse wol
  581.     }
  582.    if
  583.  
  584. % Write the CharStrings entries.
  585. % Detect identical (eq) entries, which bdftops produces.
  586.    currentdict /CharStrings known
  587. {
  588.    /CharStrings wo CharStrings length wo
  589.    minimize
  590.     { encrypt_CharStrings not wo ( .readCharStrings) wl
  591.       CharStrings length dict
  592.       CharStrings
  593.        { exch inverseencodings 1 index .knownget not { dup } if wo
  594.         % Stack: vdict value key
  595.      3 copy pop .knownget { wo pop pop } { 3 copy put pop wcs } ifelse
  596.        } forall
  597.     }
  598.     { {dict dup Private begin begin} wol () wl
  599.       CharStrings length dict
  600.       CharStrings
  601.        { 2 index 1 index known
  602.       { exch wo 1 index exch get wo {load def} wol () wl
  603.       }
  604.       { 2 index 1 index 3 index put
  605.         exch wo wcs ( |-) wl
  606.       }
  607.      ifelse
  608.        } forall
  609.       {end end} wol
  610.     }
  611.    ifelse
  612.    pop
  613.     { readonly def }    % CharStrings in font
  614.    wol
  615. }
  616. if
  617.  
  618. % Terminate the output.
  619.    end            % Font
  620.    eexec_encrypt
  621.     { {end mark currentfile closefile} wol () wl
  622.       eexecfilter dup flushfile closefile    % psfile is eexecfilter
  623.       binary_CharStrings not { hexfilter dup flushfile closefile } if
  624.       /psfile realpsfile store
  625.       8
  626.        { (0000000000000000000000000000000000000000000000000000000000000000)
  627.          wl
  628.        }
  629.       repeat {cleartomark} wol
  630.     }
  631.    if
  632.     { FontName currentdict end definefont pop
  633.     }
  634.    wol
  635.    Font /UniqueID known { /exec cvx wo } if
  636.    binary_tokens { /setobjectformat cvx wo } if
  637.    ( end) wl        % systemdict
  638.  
  639.  } bind def
  640.  
  641. % ------ Other utilities ------ %
  642.  
  643. % Prune garbage characters and OtherSubrs out of the current font,
  644. % if the relevant dictionaries are writable.
  645. /prunefont
  646.  { currentfont /CharStrings get wcheck
  647.     { currentfont /CharStrings get dup [ exch
  648.        { pop dup (S????00?) .stringmatch not { pop } if
  649.        } forall
  650.       ] { 2 copy undef pop } forall pop
  651.     }
  652.    if
  653.  } bind def
  654.  
  655. end            % wrfont_dict
  656.  
  657. /writefont { wrfont_dict begin writefont end } def
  658.